perm filename QUADO.F4[TMP,LCS] blob
sn#108376 filedate 1974-09-17 generic text, type T, neo UTF8
00100 SUBROUTINE QUADO(P,IPAR,NL,XF,YF)
00200 DIMENSION P(30),FAC(4)
00300 EQUIVALENCE(XA,FAC(1)),(XB,FAC(2)),(XC,FAC(3)),(XD,FAC(4))
00310 DATA SQ200/14.142/
00400 XC=0
00500 XD=0
00550 IF(XF.EQ.999.)KNT=0
00575 KNT=KNT+1
00587 C COUNTER IS TO 0 1ST CELL OF DPPLR ARRAY(SPD IS NOT KNOWN YET)
00600 IF(NL.EQ.-14.OR.NL.EQ.-16)GO TO 1
00700 C -14 OR -16=X,Y SYSTEM
00800 DG=P(IPAR-4)
00900 C DG=DEGREES
01500 DIS=P(IPAR-3)
01600 C RADIUS OF CIRCLE
01700 XX=P(IPAR-2)
01800 YY=P(IPAR-1)
01900 C XX,YY IS CENTER OF CIRCLE
02000 X=DIS*SIND(DG)+XX
02100 Y=DIS*COSD(DG)+YY
02920 XF=X
02960 YF=Y
03000 GO TO 10
03100
03200 1 X=P(IPAR-4)
03300 Y=P(IPAR-3)
03400 XF=X
03500 YF=Y
03550 C XF AND YF SAVE COORDS FOR SHOWING PATH ON DPY.
03600 10 DIS=SQRT(X**2+Y**2)
03700 C DIST. OF SOUND FROM LISTENER
03750 IQUAD=1
03800 S=X
03900 T=Y
04000 XX=ABS(X)
04100 YY=ABS(Y)
04200 C NEXT FINDS QUADRANT
04300 IF(X.LT.YY)GO TO 7
04400 IQUAD=2
04500 S=-Y
04600 T=X
04700 GO TO 3
04800 7 IF(-Y.LT.XX)GO TO 8
04900 IQUAD=3
05000 S=-X
05100 T=-Y
05200 GO TO 3
05300 8 IF(-X.LE.YY)GO TO 3
05400 IQUAD=4
05500 S=Y
05600 T=-X
05700 3 XA=.5-S/(T*2)
05800 XB=1-XA
05900 C % OF SNUND IN EACH "FRONT" SPEAKER
06000 IF(DIS.GE.SQ200)GO TO 30
06100 C OUTSIDE OF SPEAKER CIRCLE, THEN JUMP
06150 CC X=1-DIS/SQ200
06200 X=(1-DIS/SQ200)**2
06300 C FACTOR (OR TRY? (1-DIS/SQ200)**2 )
06400 XA=XA+(1-XA)*X
06500 XB=XB+(1-XB)*X
06600 XC=XB*X
06700 XD=XA*X
06710 CV Q=ABS(S)
06720 CV B=(T+ABS(S))/2.
06730 CV Q=1-SQRT((B-S)**2+(B-T)**2)/SQ200
06740 CV R=1-SQRT(2*B**2)/SQ200
06750 CV IF(S.LT.0)GO TO 32
06760 CV XA=Q
06770 CV XB=R
06780 CV GO TO 33
06790 CV32 XA=R
06800 CV XB=S
06802 CV33 U=(T+10)**2
06806 CV V=1-DIS/SQ200
06810 CV XC=V*SQ200/SQRT((10.-S)**2+U)
06815 C FINDS DIST TO SPEAKER.
06820 CV XD=V*SQ200/SQRT((10.+S)**2+U)
06900 GO TO 31
06990 C SUM OF FACTORS WILL BE FROM 1(AT EDGE) TO 4(AT CENTER)
07000 30 X=1-((DIS-SQ200)/DIS)**2
07100 C OUTSIDE CIRCLE (TRY ALSO SANS **)
07200 XA=XA*X
07300 XB=XB*X
07400 31 N=IPAR-5
07500 IQUAD=IQUAD-1
07600 DO 2 K=1,4
07700 J=IQUAD+K
07800 IF(J.GT.4)J=J-4
07900 2 P(J+N)=FAC(K)
08000 C SETS DIR. SIG. MULTIPLIERS FOR EACH SPKR
08010 T=P(1)-TIME1
08020 V=(DIS1-DIS)/T
08030 P(IPAR)=DIS1/(DIS1-V)
08040 C P(IPAR) IS FREQ MULTIPLIER FOR DOPPLER SHIFT
08050 TIME1=P(1)
08060 DIS1=DIS
08070 C SAVE DIS AND TIME FOR NEXT TIME AROUND
08100 IF(KNT.EQ.1)P(IPAR)=0
08110 C ZERO FREQ MULTIPLIER FIRST TIME.
08120 C IN FUNCTION IT WILL BE MADE EQUAL TO SECOND SLOT
08200 RETURN
08300 END
08400 C CAN BE USED FOR 2 CHANS. BUT 5 PARAMS STILL NEEDED.